Visual Basic Graphics Programming (2nd Edition)/Visual Basic Graphics Programming 2nd Edition.iso/OldSrc/CH10/SRC/OBJGRID1.CLS

Text File | 1996-05-04 | 6KB | 211 lines

VERSION 1.0 CLASS
BEGIN
  MultiUse = -1  'True
END
Attribute VB_Name = "ObjGrid3D"
Attribute VB_Creatable = False
Attribute VB_Exposed = False
Option Explicit

Private Xmin As Single      ' Min X and Y values.
Private Zmin As Single
Private Dx As Single        ' Spacing between rows of data.
Private Dz As Single
Private NumX As Integer     ' Number of X and Y entries.
Private NumZ As Integer
Private Points() As Point3D ' Data values.

' ************************************************
' Create the Points array.
' ************************************************
Sub SetBounds(x1 As Single, deltax As Single, xnum As Integer, z1 As Single, deltaz As Single, znum As Integer)
Dim i As Integer
Dim j As Integer
Dim x As Single
Dim z As Single

    Xmin = x1
    Zmin = z1
    Dx = deltax
    Dz = deltaz
    NumX = xnum
    NumZ = znum
    ReDim Points(1 To NumX, 1 To NumZ)

    x = Xmin
    For i = 1 To NumX
        z = Zmin
        For j = 1 To NumZ
            Points(i, j).coord(1) = x
            Points(i, j).coord(2) = 0
            Points(i, j).coord(3) = z
            Points(i, j).coord(4) = 1#
            z = z + Dz
        Next j
        x = x + Dx
    Next i
End Sub
' ************************************************
' Save the indicated data value.
' ************************************************
Sub SetValue(x As Single, y As Single, z As Single)
Dim i As Integer
Dim j As Integer

    i = (x - Xmin) / Dx + 1
    j = (z - Zmin) / Dz + 1
    Points(i, j).coord(2) = y
End Sub

' ***********************************************
' Return a string indicating the object type.
' ***********************************************
Property Get ObjectType() As String
    ObjectType = "GRID"
End Property



' ***********************************************
' Fix the data coordinates at their transformed
' values.
' ***********************************************
Public Sub FixPoints()
Dim i As Integer
Dim j As Integer
Dim k As Integer

    For i = 1 To NumX
        For j = 1 To NumZ
            For k = 1 To 3
                Points(i, j).coord(k) = Points(i, j).trans(k)
            Next k
        Next j
    Next i
End Sub

' ************************************************
' Apply a transformation matrix which may not
' contain 0, 0, 0, 1 in the last column to the
' object.
' ************************************************
Public Sub ApplyFull(M() As Single)
Dim i As Integer
Dim j As Integer

    For i = 1 To NumX
        For j = 1 To NumZ
            m3ApplyFull Points(i, j).coord, M, Points(i, j).trans
        Next j
    Next i
End Sub

' ************************************************
' Apply a transformation matrix to the object.
' ************************************************
Public Sub Apply(M() As Single)
Dim i As Integer
Dim j As Integer

    For i = 1 To NumX
        For j = 1 To NumZ
            m3Apply Points(i, j).coord, M, Points(i, j).trans
        Next j
    Next i
End Sub


' ************************************************
' Apply a nonlinear transformation.
' ************************************************
Public Sub Distort(D As Object)
Dim i As Integer
Dim j As Integer

    For i = 1 To NumX
        For j = 1 To NumZ
            D.Distort Points(i, j).coord(1), Points(i, j).coord(2), Points(i, j).coord(3)
        Next j
    Next i
End Sub

' ************************************************
' Write a grid to a file using Write.
' Begin with "GRID" to identify this object.
' ************************************************
Public Sub FileWrite(filenum As Integer)
Dim i As Integer
Dim j As Integer

    ' Write basic information.
    Write #filenum, _
        "GRID", Xmin, Zmin, Dx, Dz, NumX, NumZ

    ' Write the Z values.
    For i = 1 To NumX
        For j = 1 To NumZ
            Write #filenum, Points(i, j).coord(2)
        Next j
    Next i
End Sub



' ************************************************
' Draw the transformed points on a Form, Printer,
' or PictureBox.
' ************************************************
Public Sub Draw(canvas As Object, Optional r As Variant)
Dim i As Integer
Dim j As Integer

    On Error Resume Next

    ' Draw lines parallel to the X axis.
    For i = 1 To NumX
        canvas.CurrentX = Points(i, 1).trans(1)
        canvas.CurrentY = Points(i, 1).trans(2)
        For j = 2 To NumZ
            canvas.Line -(Points(i, j).trans(1), _
                          Points(i, j).trans(2))
        Next j
    Next i

    ' Draw lines parallel to the Y axis.
    For j = 1 To NumZ
        canvas.CurrentX = Points(1, j).trans(1)
        canvas.CurrentY = Points(1, j).trans(2)
        For i = 2 To NumX
            canvas.Line -(Points(i, j).trans(1), _
                          Points(i, j).trans(2))
        Next i
    Next j
End Sub


' ************************************************
' Read a grid from a file using Input.
' Assume the "GRID" label has alreaDz been
' read.
' ************************************************
Public Sub FileInput(filenum As Integer)
Dim i As Integer
Dim j As Integer

    ' Get the basic information.
    Input #filenum, Xmin, Zmin, Dx, Dz, NumX, NumZ

    ' Allocate the Points array and set the X and
    ' Y values.
    SetBounds Xmin, Dx, NumX, Zmin, Dz, NumZ

    ' Read the Z values.
    For i = 1 To NumX
        For j = 1 To NumZ
            Input #filenum, Points(i, j).coord(2)
        Next j
    Next i
End Sub